home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / xf2.3-p / xf2 / xf2.3 / src / xfbind.tcl < prev    next >
Encoding:
Text File  |  1993-11-20  |  8.8 KB  |  313 lines
  1. # Program: xf
  2. # Description: bindings
  3. #
  4. # $Header: xfbind.tcl[2.3] Wed Mar 10 12:05:23 1993 garfield@garfield frozen $
  5.  
  6. ##########
  7. # Procedure: XFBindRemoveName
  8. # Description: action to remove the displayed widget name
  9. # Arguments: xfW - the widget
  10. # Returns: none
  11. # Sideeffects: none
  12. ##########
  13. proc XFBindRemoveName {} {
  14.  
  15.   catch "destroy .xfShowName"
  16. }
  17.  
  18. ##########
  19. # Procedure: XFBindFormConnect
  20. # Description: connect all packed entry/text childs
  21. # Arguments: xfWList - the widgetlist
  22. #            {xfCommand} - an optional command to bind to <Return>
  23. #            {xfInternal} - an internal flag
  24. # Returns: none
  25. # Sideeffects: none
  26. ##########
  27. proc XFBindFormConnect {xfWList {xfCommand ""} {xfInitial 1}} {
  28.  
  29.   set xfType 0
  30.   set xfPackList ""
  31.   foreach xfW $xfWList {
  32.     if {("[winfo class $xfW]" == "Entry" ||
  33.          "[winfo class $xfW]" == "Text" ||
  34.          "[winfo class $xfW]" == "TkEmacs")} {
  35.       lappend xfPackList $xfW
  36.     }
  37.     foreach xfElement [pack info $xfW] {
  38.       if {$xfType == 0} {
  39.         if {("[winfo class $xfElement]" == "Entry" ||
  40.              "[winfo class $xfElement]" == "Text" ||
  41.              "[winfo class $xfElement]" == "TkEmacs")} {
  42.           eval lappend xfPackList $xfElement
  43.         }
  44.         if {"[pack info $xfElement]" != ""} {
  45.           if {"[info procs XFBindFormConnect]" != ""} {
  46.             set xfTmpPackList [XFBindFormConnect $xfElement $xfCommand 0]
  47.           } {
  48.             if {"[info procs XFLocalFormConnect]" != ""} {
  49.               set xfTmpPackList [XFLocalFormConnect $xfElement $xfCommand 0]
  50.             } {
  51.               set xfTmpPackList ""
  52.             }
  53.           }
  54.           if {"$xfTmpPackList" != ""} {
  55.             eval lappend xfPackList $xfTmpPackList
  56.           }
  57.         }
  58.         set xfType 1
  59.       } {
  60.         set xfType 0
  61.       }
  62.     }
  63.   }
  64.   if {$xfInitial} {
  65.     set xfFromWidget ""
  66.     set xfToWidget ""
  67.     set xfCounter 1
  68.     foreach xfElement $xfPackList {
  69.       set xfToWidget [lindex $xfPackList $xfCounter]
  70.       if {"[info procs XFBindForms]" != ""} {
  71.         XFBindForms $xfElement $xfFromWidget $xfToWidget $xfCommand
  72.       } {
  73.         if {"[info procs XFLocalFormBind]" != ""} {
  74.           XFLocalFormBind $xfElement $xfFromWidget $xfToWidget $xfCommand
  75.         }
  76.       }
  77.       set xfFromWidget $xfElement
  78.       incr xfCounter
  79.     }
  80.   } {
  81.     return $xfPackList
  82.   }
  83. }
  84.  
  85. ##########
  86. # Procedure: XFBindFocusIn
  87. # Description: focus on text
  88. # Arguments: xfW - the widget
  89. # Returns: none
  90. # Sideeffects: none
  91. ##########
  92. proc XFBindFocusIn {xfW} {
  93.   global tkVersion
  94.  
  95.   if {"[winfo class $xfW]" == "Entry"} {
  96.     if {$tkVersion >= 3.0} {
  97.       $xfW icursor 0
  98.     } {
  99.       $xfW cursor 0
  100.     }
  101.   } {
  102.     if {"[winfo class $xfW]" == "Text"} {
  103.       $xfW mark set insert 1.0
  104.     } {
  105.       if {"[winfo class $xfW]" == "TkEmacs"} {
  106.         $xfW mark set insert 0.0
  107.       }
  108.     }
  109.   }
  110.   focus $xfW
  111. }
  112.  
  113. ##########
  114. # Procedure: XFBindForms
  115. # Description: specify bindings for form style handling of text fields
  116. # Arguments: xfW - the widget
  117. #            xfPrevW - the previous widget
  118. #            xfNextW - the next widget
  119. #            {xfCommand} - a command to bind to <Return>
  120. # Returns: none
  121. # Sideeffects: none
  122. ##########
  123. proc XFBindForms {xfW xfPrevW xfNextW {xfCommand ""}} {
  124.  
  125.   if {"[info procs XFBindFocusIn]" != ""} {
  126.     set xfFocusCmd XFBindFocusIn
  127.   } {
  128.     if {"[info procs XFLocalFocusIn]" != ""} {
  129.       set xfFocusCmd XFLocalFocusIn
  130.     } {
  131.       return
  132.     }
  133.   }
  134.  
  135.   if {"$xfPrevW" != ""} {
  136.     if {"[winfo class $xfW]" == "Entry"} {
  137.       bind $xfW <Up> "$xfFocusCmd $xfPrevW"
  138.       bind $xfW <Control-Up> "$xfFocusCmd $xfPrevW"
  139.       bind $xfW <Meta-Up> "$xfFocusCmd $xfPrevW"
  140.     } {
  141.       if {"[winfo class $xfW]" == "Text"} {
  142.         bind $xfW <Control-Up> "$xfFocusCmd $xfPrevW"
  143.         bind $xfW <Meta-Up> "$xfFocusCmd $xfPrevW"
  144.       } {
  145.         if {"[winfo class $xfW]" == "TkEmacs"} {
  146.           bind $xfW <Control-Up> "$xfFocusCmd $xfPrevW"
  147.           bind $xfW <Meta-Up> "$xfFocusCmd $xfPrevW"
  148.         }
  149.       }
  150.     }
  151.   } {
  152.     if {"[winfo class $xfW]" == "Entry"} {
  153.       catch "bind $xfW <Up> {NoFunction}"
  154.       catch "bind $xfW <Control-Up> {NoFunction}"
  155.       catch "bind $xfW <Meta-Up> {NoFunction}"
  156.     } {
  157.       if {"[winfo class $xfW]" == "Text"} {
  158.         catch "bind $xfW <Control-Up> {NoFunction}"
  159.         catch "bind $xfW <Meta-Up> {NoFunction}"
  160.       } {
  161.         if {"[winfo class $xfW]" == "TkEmacs"} {
  162.           catch "bind $xfW <Control-Up> {NoFunction}"
  163.           catch "bind $xfW <Meta-Up> {NoFunction}"
  164.         }
  165.       }
  166.     }
  167.   }
  168.   if {"$xfNextW" != ""} {
  169.     if {"[winfo class $xfW]" == "Entry"} {
  170.       bind $xfW <Down> "$xfFocusCmd $xfNextW"
  171.       bind $xfW <Control-Down> "$xfFocusCmd $xfNextW"
  172.       bind $xfW <Meta-Down> "$xfFocusCmd $xfNextW"
  173.       bind $xfW <Return> "$xfCommand; $xfFocusCmd $xfNextW"
  174.       bind $xfW <Control-Return> "$xfCommand; $xfFocusCmd $xfNextW"
  175.       bind $xfW <Meta-Return> "$xfCommand; $xfFocusCmd $xfNextW"
  176.     } {
  177.       if {"[winfo class $xfW]" == "Text"} {
  178.         bind $xfW <Control-Down> "$xfFocusCmd $xfNextW"
  179.         bind $xfW <Meta-Down> "$xfFocusCmd $xfNextW"
  180.         bind $xfW <Control-Return> "$xfCommand; $xfFocusCmd $xfNextW"
  181.         bind $xfW <Meta-Return> "$xfCommand; $xfFocusCmd $xfNextW"
  182.       } {
  183.         if {"[winfo class $xfW]" == "TkEmacs"} {
  184.           bind $xfW <Control-Down> "$xfFocusCmd $xfNextW"
  185.           bind $xfW <Meta-Down> "$xfFocusCmd $xfNextW"
  186.           bind $xfW <Control-Return> "$xfCommand; $xfFocusCmd $xfNextW"
  187.           bind $xfW <Meta-Return> "$xfCommand; $xfFocusCmd $xfNextW"
  188.         }
  189.       }
  190.     }
  191.   } {
  192.     if {"[winfo class $xfW]" == "Entry"} {
  193.       catch "bind $xfW <Down> {NoFunction}"
  194.       catch "bind $xfW <Control-Down> {NoFunction}"
  195.       catch "bind $xfW <Meta-Down> {NoFunction}"
  196.       catch "bind $xfW <Return> \"$xfCommand; NoFunction\""
  197.       catch "bind $xfW <Control-Return> \"$xfCommand; NoFunction\""
  198.       catch "bind $xfW <Meta-Return> \"$xfCommand; NoFunction\""
  199.     } {
  200.       if {"[winfo class $xfW]" == "Text"} {
  201.         catch "bind $xfW <Control-Down> {NoFunction}"
  202.         catch "bind $xfW <Meta-Down> {NoFunction}"
  203.         catch "bind $xfW <Control-Return> \"$xfCommand; NoFunction\""
  204.         catch "bind $xfW <Meta-Return> \"$xfCommand; NoFunction\""
  205.       } {
  206.         if {"[winfo class $xfW]" == "TkEmacs"} {
  207.           catch "bind $xfW <Control-Down> {NoFunction}"
  208.           catch "bind $xfW <Meta-Down> {NoFunction}"
  209.           catch "bind $xfW <Control-Return> \"$xfCommand; NoFunction\""
  210.           catch "bind $xfW <Meta-Return> \"$xfCommand; NoFunction\""
  211.         }
  212.       }
  213.     }
  214.   }
  215. }
  216.  
  217. ##########
  218. # Procedure: XFBindShowName
  219. # Description: action to show the current pathname and to store him
  220. #              into the selection buffer for later pasting
  221. # Arguments: xfW - the widget
  222. #            xfX - x position in widget
  223. #            xfY - y position in widget
  224. # Returns: none
  225. # Sideeffects: none
  226. ##########
  227. proc XFBindShowName {xfW xfX xfY} {
  228.   global symbolicName
  229.   global xfConf
  230.  
  231.   XFTmpltToplevel .xfShowName 200x80 {XF widget name}
  232.  
  233.   if {$xfConf(autoPos)} {
  234.     set xfPosX [expr $xfX+[winfo rootx $xfW]+30]
  235.     set xfPosY [expr $xfY+[winfo rooty $xfW]+30]
  236.     wm positionfrom .xfShowName user
  237.     wm geometry .xfShowName "200x80+$xfPosX+$xfPosY"
  238.   }
  239.  
  240.   label .xfShowName.descr1 \
  241.     -anchor c \
  242.     -relief raised \
  243.     -text "This widget is named:"
  244.   
  245.   set xfName $xfW
  246.   set xfShowName $xfW
  247.   foreach xfCounter [array names symbolicName] {
  248.     set xfArrayName ""
  249.     append xfArrayName symbolicName ( $xfCounter )
  250.     if {"$xfName" == "[set $xfArrayName]"} {
  251.       set xfName $xfCounter
  252.       set xfShowName [SymbolicName "$xfCounter"]
  253.     }
  254.   }
  255.  
  256.   message .xfShowName.descr2 \
  257.     -justify center \
  258.     -width 190 \
  259.     -anchor n \
  260.     -relief raised \
  261.     -text "$xfName"
  262.   
  263.   .xfEdit.curSelected delete 0 end
  264.   .xfEdit.curSelected insert 0 $xfShowName
  265.   .xfEdit.curSelected select from 0
  266.   .xfEdit.curSelected select to end
  267.  
  268.   pack append .xfShowName \
  269.               .xfShowName.descr1 {top fill} \
  270.               .xfShowName.descr2 {top fill expand}
  271. }
  272.  
  273. ##########
  274. # Procedure: XFBindSelectOne
  275. # Description: action to select the current list item
  276. # Arguments: xfW - the widget
  277. #            xfY - the y position in the listbox
  278. # Returns: none
  279. # Sideeffects: none
  280. ##########
  281. proc XFBindSelectOne {xfW xfY} {
  282.  
  283.   set xfNearest [$xfW nearest $xfY]
  284.   if {$xfNearest >= 0} {
  285.     $xfW select from $xfNearest
  286.     $xfW select to $xfNearest
  287.   }
  288. }
  289.  
  290. ##########
  291. # Procedure: XFBindSelectOneIntoEntry
  292. # Description: action to select the current list item,
  293. #              and insert the value into a entry widget
  294. # Arguments: xfW - the widget
  295. #            xfY - the y position in the listbox
  296. #            xfEntry -the entry
  297. # Returns: none
  298. # Sideeffects: none
  299. ##########
  300. proc XFBindSelectOneIntoEntry {xfW xfY xfEntry} {
  301.  
  302.   set xfNearest [$xfW nearest $xfY]
  303.   if {$xfNearest >= 0} {
  304.     $xfW select from $xfNearest
  305.     $xfW select to $xfNearest
  306.     $xfEntry delete 0 end
  307.     $xfEntry insert 0 [$xfW get $xfNearest]
  308.   }
  309. }
  310.  
  311. # eof
  312.  
  313.